home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
050
/
madtrb4.arc
/
GETFILE.LIB
< prev
next >
Wrap
Text File
|
1984-12-03
|
4KB
|
116 lines
{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.
GETFILE consists of a set of three procedures based on a variable-type
BUFFER-TYPE, which is the exact "shape" of the information returned by
DOS function calls $4E (Find First matching file) and $4F (Find Next).
SetDTA is called by Find_First to Set the Data Transfer Area to the Buffer.
Find_First takes as input the file attribute and name-template of the file
required and returns the actual attribute found, the first matching name,
and an error code.
Find_Next takes no input, but the buffer must be initialized by Find_First.
The output of Find_Next is the same as that of Find_First.
Any program that calls GETFILE must also INCLUDE the standard type definitions
in FILENAME.TYP and REGPACK.TYP.
The procedures of GETFILE are used by ALLFILES.LIB for a very handy file
selection module.}
{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
type
buffer_type = record
reserved : array[1..21] of byte;
attribute: byte;
time, date, FileSizeLo, FileSizeHi : integer;
name : string[13];
end;
var
error : byte;
filename : filename_type; {NOTE that filename_type is declared in
the file FILENAME.TYP. This is in order
to avoid multiple declarations}
buffer : buffer_type;
attribute : byte;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure SetDTA(var buff);
var
registers : regpack;
begin
with registers do
begin
AX := $1A shl 8;
DS := seg(buff);
DX := ofs(buff);
MSDOS(registers);
end;
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure Find_Next(var att:byte; var filename : filename_type;
var Next_error : byte);
var
registers : regpack;
carry_flag : integer;
N : byte;
begin
buffer.name := ' ';
with registers do
begin
AX := $4F shl 8;
MSDOS(registers);
att := buffer.attribute;
carry_flag := 1 and Flags;
filename := ' ';
If carry_flag = 1 then
Next_error := AX and $00FF
else
begin
Next_error := 0;
for N := 0 to 12 do FileName[N+1] := buffer.name[N];
end;
end; {with}
att := buffer.attribute;
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
Procedure Find_First (VAR att: byte;
var filename: filename_type;
var error_code : byte);
var
registers :regpack;
carry_flag :integer;
mask, N :byte;
begin
SetDTA(buffer);
filename[Length(filename) + 1] := chr(0);
buffer.name := ' ';
With registers do
begin
AX := $4E shl 8;
CX := att;
DS := Seg(filename);
DX := Ofs(filename) + 1;
MsDos(registers);
att := buffer.attribute;
{ If there was an error set the error code and don't do
anything else. }
carry_flag := 1 and Flags;
If carry_flag = 1 then
begin
error_code := AX and $00FF;
end
else
begin
error_code := 0;
filename := ' ';
for N := 0 to 12 do FileName[N+1] := buffer.name[N];
end;
end; {with}
end;